Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr01/halcn305.zip/GSOB_EDT.PAS

Pascal/Delphi Source File | 1993-05-10 | 14KB | 542 lines

{-----------------------------------------------------------------------------
                                 Editor Routines

       GSOB_Edt Copyright (c)  Richard F. Griffin

       08 May 1993

       102 Molded Stone Pl
       Warner Robins, GA  31088

       -------------------------------------------------------------
       This unit handles the objects for a simple editor.

                 --- DOES NOT COMPILE UNDER WINDOWS ---

       Changes:

------------------------------------------------------------------------------}

Unit GSOB_Edt;

interface

uses
   GSOB_Obj,
   GSOB_Str,
   CRT,
   DOS;

type

   TEvent = record
      What: Integer;
      case Integer of
            0: (KeyCode: Word);
            1: (CharCode: Char;
                ScanCode: Byte);
   end;

   TPoint = Record
      X : Integer;
      Y : Integer;
   end;


   GSP_ShowView = ^GSO_ShowView;
   GSO_ShowView = object(TObject)
      edLineColl  : GSP_LineCollection;
      LineRet     : byte;
      Work_Line   : string;
      LineOnly    : boolean;
      Cursor,
      Delta,
      Size,
      Limit,
      PhyPos      : TPoint;
      constructor Init(P : GSP_LineCollection);
      procedure   Draw; virtual;
      procedure   FindLine(linenum : integer);
      procedure   FixView;
      procedure   HandleEvent(var Event : TEvent); virtual;
      function    WorkView : boolean;
   end;

   GSP_EditView = ^GSO_EditView;
   GSO_EditView = object(GSO_ShowView)
      Edit_Lgth   : integer;          {Max size of each line}
      InsertOn    : boolean;
      Modified    : boolean;
      constructor Init(P : GSP_LineCollection; L : Integer);
      Procedure   Draw; virtual;
      Procedure   EditLine(Ch_Work : char);
      procedure   GetNewLine;
      procedure   HandleEvent(var Event : TEvent); virtual;
      Procedure   Pressed_Bsp;
      Procedure   Pressed_CrtlY;
      Procedure   Pressed_Del;
      Procedure   Pressed_Ret;
      procedure   PutLine;
      procedure   ReleaseLine;
      Procedure   WordWrap;
   end;

implementation

const

   InsStatOn  = '[Ins]';
   InsStatOff = '[OvL]';
   EmptyLine  : String[1] = '';
   TabSpaces  = 8;


{ Extended key codes }

   kbEsc       = $011B;
   kbBack      = $0E08;
   kbShiftTab  = $0F00;
   kbTab       = $0F09;
   kbEnter     = $1C0D;
   kbF1        = $3B00;
   kbF10       = $4400;
   kbHome      = $4700;
   kbUp        = $4800;
   kbPgUp      = $4900;
   kbLeft      = $4B00;
   kbRight     = $4D00;
   kbEnd       = $4F00;
   kbDown      = $5000;
   kbPgDn      = $5100;
   kbIns       = $5200;
   kbDel       = $5300;
   kbCtrlEnd   = $7500;
   kbCtrlPgDn  = $7600;
   kbCtrlHome  = $7700;
   kbCtrlPgUp  = $8400;

var
   Tmp_Line : string;
   Ch_Work  : char;

   GS_KeyE_Scn   : byte;
   GS_KeyE_Esc,
   GS_KeyE_Fuc   : boolean;
   GS_KeyE_Chr,
   GS_KeyE_Cde   : char;


{ GS_KeyE_GetKey reads and returns a character from the keyboard.  If the
  character is a function key, GS_KeyE_Func is set true.  The character is
  also saved in unit local variable GS_KeyE_Chr.  The scan code is saved in
  unit local variable GS_KeyE_ScanCode. }

function GS_KeyE_GetKey : char;
var
   reg : Registers;
begin
  reg.AX := 0;
  Intr($16,reg);
  GS_KeyE_Cde := char(reg.AL);
  GS_KeyE_Scn := reg.AH;
  if GS_KeyE_Cde = #0 then
    begin
      GS_KeyE_Fuc := true;
      GS_KeyE_Chr := char(GS_KeyE_Scn);
    end
  else
  begin
    GS_KeyE_Fuc := false;
    GS_KeyE_Chr := GS_KeyE_Cde;
  end;
  GS_KeyE_GetKey := GS_KeyE_Chr;
end; {GS_KeyE_GetKey}



{------------------------------------------------------------------------------
                                GSO_ShowView
------------------------------------------------------------------------------}

constructor GSO_ShowView.Init(P : GSP_LineCollection);
var
   i : integer;
begin
   Cursor.X := 0;
   Cursor.Y := 0;
   Size.X := Lo(WindMax)-Lo(WindMin)+1;
   Size.Y := Hi(WindMax)-Hi(WindMin)-1;
   Delta.X := 0;
   Delta.Y := 0;
   Limit.X := Size.X;
   Limit.Y := P^.Count;
   PhyPos.X := 0;
   PhyPos.Y := 0;
   Work_Line := '';
   edLineColl := P;
   LineOnly := false;
   GoToXY(1,Size.Y+1);
   for i := 1 to Size.X do write(#205);
   GoToXY(1,Size.Y+2);
   write(' F10 to Quit    ESC to Abort');
   if edLineColl^.Count = 0 then exit;
   FindLine(0);
   Draw;
end;

procedure GSO_ShowView.Draw;
var
   Y     : Integer;
   i     : integer;
   s     : String;
   z     : boolean;
begin
   FixView;
   for Y := 0 to Size.Y-1 do
   begin
      z := false;
      i := (Y+Delta.Y);
      if i > Limit.Y then z := true;
      if (LineOnly) then
          if Y = Cursor.Y then
             s := Work_Line else z := true
      else
      if (i < edLineColl^.Count) then
            s := GSP_LineBuf(edLineColl^.Items^[i])^.LineText
         else
            s := EmptyLine;
      if not z then
      begin
         FillChar(Tmp_Line[1],Size.X,' ');
         Tmp_Line := s;
         Tmp_Line[0] := char(Size.X);
         GoToXY(1,Y+1);
         Write(Tmp_Line);
      end
      else if (i > Limit.Y) and not LineOnly then
      begin
         GoToXY(1,Y+1);
         ClrEol;
      end;
   end;
   LineOnly := false;
   gotoxy(65,Size.Y+2);
   write('Line: ',PhyPos.Y+1,'':4);
   GoToXY(1,Cursor.Y+1);
end;

procedure GSO_ShowView.FindLine(linenum : integer);
var
   p : GSP_LineBuf;
begin
   if linenum < 0 then linenum := 0;
   if linenum >= edLineColl^.Count then linenum := edLineColl^.Count-1;
   p := edLineColl^.At(linenum);
   Work_Line := p^.LineText;
   LineRet := p^.LineRetn;
   PhyPos.Y := linenum;
end;

procedure GSO_ShowView.FixView;
var
   D : TPoint;
begin
   D := Delta;
   if Cursor.Y > Size.Y-1 then
   begin
      Delta.Y := Delta.Y + (Cursor.Y-(Size.Y-1));
      Cursor.Y := Size.Y-1;
   end
   else
   begin
      if Cursor.Y < 0 then
      begin
         Delta.Y := Delta.Y+Cursor.Y;
         Cursor.Y := 0;
      end;
   end;
   if Delta.Y >= Limit.Y then Delta.Y := Limit.Y-1;
   if Delta.Y < 0 then Delta.Y := 0;
   if Cursor.X >= Size.X then Cursor.X := Size.X-1
   else
      if Cursor.X < 0 then Cursor.X := 0;
   FindLine(Delta.Y+Cursor.Y);
   Cursor.Y := (PhyPos.Y - Delta.Y);
   if Cursor.Y < 0 then Cursor.Y := 0;
   if Cursor.Y >= (Limit.Y) then Cursor.Y := Limit.Y-1;
   PhyPos.X := Cursor.X;
   LineOnly := LineOnly and (D.Y = Delta.Y);
end;

procedure GSO_ShowView.HandleEvent(var Event : TEvent);
var
   cw    : char;
   D,
   Mouse : TPoint;
begin
   D := Delta;
   case Event.KeyCode of
      kbCtrlPgUp : Delta.Y := 0;
      kbCtrlPgDn : Delta.Y := Limit.Y;
      kbCtrlHome : Cursor.Y := 0;
      kbCtrlEnd  : Cursor.Y := Size.Y-1;
      kbPgUp     : Delta.Y := Delta.Y-(Size.Y)-1;
      kbPgDn     : Delta.Y := Delta.Y+(Size.Y)-1;
      kbHome     : Cursor.X := 0;
      kbEnd      : Cursor.X := Length(Work_Line);
      kbLeft     : if Cursor.X > 0 then Dec(Cursor.X);
      kbRight    : if Cursor.X < Length(Work_Line) then Inc(Cursor.X);
      kbUp       : dec(Cursor.Y);
      kbDown     : inc(Cursor.Y);
      kbEsc,
      kbF10      : begin end;
      else exit;
   end;
   LineOnly := D.Y = Delta.Y;
   if edLineColl^.Count > 0 then Draw;
   Event.KeyCode := 0;
END;

Function GSO_ShowView.WorkView : boolean;
var
   Event : TEvent;
   kch   : char;
   kcd   : word;
begin
   repeat
      kch := GS_KeyE_GetKey;  {Get the next keyboard entry}
      Event.CharCode := GS_KeyE_Cde;
      Event.ScanCode := GS_KeyE_Scn;
      kcd := Event.KeyCode;
      HandleEvent(Event);
   until (kcd = kbF10) or (kcd = kbEsc);
   WorkView := kcd <> kbEsc;
end;

{------------------------------------------------------------------------------
                                GSO_EditView
------------------------------------------------------------------------------}

constructor GSO_EditView.Init(P : GSP_LineCollection; L : Integer);
begin
   GSO_ShowView.Init(P);
   Modified := false;
   Edit_Lgth := L;
   InsertOn := True;               {Start in insert mode}
   if L > Size.X then Edit_Lgth := Size.X;
   if edLineColl^.Count = 0 then GetNewLine;
end;

Procedure GSO_EditView.Draw;
begin
   PutLine;
   GSO_ShowView.Draw;
   gotoxy(48,Size.Y+2);
   if InsertOn then write(InsStatOn) else write(InsStatOff);
   gotoxy(55,Size.Y+2);
   write('Col: ',Cursor.X+1:2);
   if Cursor.X > length(Work_Line) then Cursor.X := length(Work_Line);
   GotoXY(Cursor.X+1,Cursor.Y+1);  {Go to current position in the screen}
end;

Procedure GSO_EditView.EditLine(Ch_Work : char);
begin
   Modified := true;
   if InsertOn then System.Insert(Ch_Work, Work_Line, PhyPos.X+1)
      else Work_Line[PhyPos.X+1] := Ch_Work;
   Inc(PhyPos.X);                {Step to the next location in the string}
   if length(Work_Line) >= Edit_Lgth then WordWrap
      else LineOnly := true;
end; { EditLine }

procedure GSO_EditView.GetNewLine;
begin
   Work_Line := '';
   LineRet := $0D;
   edLineColl^.InsertItemAt($8D,Work_Line,PhyPos.Y);
   Limit.Y := edLineColl^.Count;
end;

procedure GSO_EditView.HandleEvent(var Event : TEvent);
begin
   GSO_ShowView.HandleEvent(Event);
   case Event.KeyCode of
      0         : Exit;
      kbBack    : Pressed_Bsp;
      kbDel     : Pressed_Del;
      kbEnter   : Pressed_Ret;
      kbIns     : InsertOn := not InsertOn;
      else
         case Event.CharCode of
         #25       : Pressed_CrtlY;
         #32..#255  : EditLine(Event.CharCode);
         else exit;
      end;
   end;
   Cursor.Y := PhyPos.Y-Delta.Y;
   Cursor.X := PhyPos.X;
   Draw;
END;

procedure GSO_EditView.Pressed_Bsp;
var
   bb : byte;
begin
   Modified := true;
   if PhyPos.X > 0 then
   begin
      System.Delete(Work_Line, PhyPos.X, 1);
      Dec(PhyPos.X);
   end
   else
   begin
      if PhyPos.Y > 0 then
      begin
         bb := LineRet;
         Tmp_Line := Work_Line;
         ReleaseLine;
         if PhyPos.Y < (Limit.Y-1) then FindLine(PhyPos.Y-1);
         PhyPos.X := length(Work_Line);
         Work_Line := Work_Line + Tmp_Line;
         LineRet := bb;
         WordWrap;
         LineOnly := false;
      end;
   end;
end;

procedure GSO_EditView.Pressed_Del;
begin
   Modified := true;
   if PhyPos.X < Length(Work_Line)-1 then
      System.Delete(Work_Line, PhyPos.X+1, 1)
   else
   begin
      if PhyPos.Y < edLineColl^.Count-1 then
      begin
         PutLine;
         FindLine(PhyPos.Y+1);
         PhyPos.X := 0;
         Pressed_Bsp;
      end;
   end;
end;

procedure GSO_EditView.Pressed_Ret;
begin         {Return}
   Modified := true;
   if InsertOn then
   begin
      Tmp_Line := copy(Work_Line,1,PhyPos.X);
      System.delete(Work_Line,1,PhyPos.X);
      PutLine;
      GetNewLine;
      LineRet := $0D;
      Work_Line := Tmp_Line;
   end;
   PutLine;
   FindLine(PhyPos.Y+1);
   PhyPos.X := 0;
end;

procedure GSO_EditView.Pressed_CrtlY;
begin
   Modified := true;
   if edLineColl^.Count = 1 then
      Work_Line := ''
   else
      ReleaseLine;
end;

Procedure GSO_EditView.PutLine;
begin
   if edLineColl^.Count = 0 then exit;
   edLineColl^.Free(edLineColl^.At(PhyPos.Y));
   edLineColl^.InsertItemAt(LineRet,Work_Line,PhyPos.Y);
end;

Procedure GSO_EditView.ReleaseLine;
begin
   if PhyPos.Y = 0 then exit;
   edLineColl^.Free(edLineColl^.At(PhyPos.Y));
   if PhyPos.Y >= edLineColl^.Count then
      PhyPos.Y := edLineColl^.Count-1;
   FindLine(PhyPos.Y);
   Limit.Y := edLineColl^.Count;
end;

Procedure GSO_EditView.WordWrap;
var
   lCnt : integer;                    {Counter for line length in characters}
   linterm : byte;                    {Holds line termination code}
   linchr : boolean;
   wrapped : boolean;
   A_L    : longint;


   function WrapLine : boolean;
   BEGIN                       { WordWrap }
      if (length(Work_Line) < Edit_Lgth) then
      begin
         WrapLine := false;
         exit;
      end;
      lCnt := Edit_Lgth;
      linchr := false;
      if Work_Line[lcnt] <> ' ' then
      begin
         dec(lcnt);
         while (not linchr) and (lcnt > 0) do
            if Work_Line[lCnt] in [' ','-'] then linchr := true
               else dec(lCnt);
      end;
      if (lCnt = 0) then lcnt := Edit_Lgth;
                                      {If no break point, truncate line}
      Tmp_Line := Work_Line;
      Work_Line[0] := chr(lcnt);
      system.delete(Tmp_Line,1,lCnt);
      if PhyPos.X >= lcnt-1 then
      begin
         PhyPos.X := PhyPos.X-lcnt;
         inc(A_L);
      end;
      WrapLine := true;
   end;

BEGIN
   wrapped := false;
   A_L := PhyPos.Y;
   while WrapLine do
   begin
      wrapped := true;
      if LineRet = $0D then
      begin
         LineRet := $8D;
         PutLine;
         inc(PhyPos.Y);
         GetNewLine;
         LineRet := $0D;
      end
      else
      begin
         PutLine;
         inc(PhyPos.Y);
         if edLineColl^.Count > PhyPos.Y then FindLine(PhyPos.Y)
            else GetNewLine;
      end;
      Work_Line := Tmp_Line + Work_Line;
   end;
   if not wrapped then
      LineOnly := true
   else
   begin
      PutLine;
      FindLine(A_L);
   end;
end;                         {WordWrap}


end.
{------------------------------------------------------------------------------}